home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 192 / 192.d81 / rh-pinochle 2 (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  25KB  |  639 lines
  1. 1 rem "rh-pinochle 2c" 2000.05.09             *** compacted version
  2. 2 gosub3002
  3. 3 gosub12:onqgoto9,4,3,3,3
  4. 4 gosub1002:onqgoto9,4:gosub1202:onqgoto9,4:ifbp=290then4
  5. 5 gosub1402:onqgoto9,4:gosub1802:onqgoto9,4:iff=2thenon2+(q<>5)goto4,3
  6. 6 gosub2002:onqgoto9,4,4,4,3
  7. 9 goto4002
  8. 12 pokevl+39,1:ifq=4thenq=3:goto30
  9. 18 sysml+9:i%=cr%:on2+(i%>0)goto22:sysml+60,a$(28):on2+(i%>0)goto22
  10. 20 on1+fnhp(p)goto22:on2+(r1%=0andr2%=0)goto18:q=4:goto30
  11. 22 q=3:ifi%<5thenoni%gosub2978,2902,2916,2964:onqgoto30,30:on2+fnhp(p)goto18,30
  12. 24 ifbn>-1thenifi%>=bnthenbq=i%-bn:goto30
  13. 26 bq=-1:c=i%-5:a=(c>=cn):c=c+cn*a
  14. 28 on2+(s%(c,p)>-1)goto30:on2+(c=0ora)goto18:c=c-1:on2+s%(c,p)goto18
  15. 30 pokevl+39,7:return
  16. 36 sysml+24,(m*b%(d%(3,0))):wait653,1,1:return
  17. 102 on2+fnec(p)gosub110,122:return
  18. 110 forc=0tocn-2:gosub138:gosub146:gosub162:onp+1gosub190,204,212,204:next
  19. 116 c=cn-1:gosub138:gosub146:gosub154:return
  20. 122 on2+(ca=0)goto134:t=pand253:forc=catocz:ontgoto130
  21. 128 sysml+126,x%(c,p),x%(c,p),y%(c,p),y%(c,p)+1,97,98,c%(2),c%(2):goto132
  22. 130 sysml+12,x%(c,p),y%(c,p),a$(23)
  23. 132 next
  24. 134 return
  25. 138 r=r%(c,p):s=s%(c,p):return
  26. 146 x=x%(ca+c,p):y=y%(ca+c,p):return
  27. 154 gosub162:onp+1gosub170,204,212,204:poke646,c%(2):return
  28. 162 poke646,c%(3+(sand253)):return
  29. 170 gosub162:sysml+12,x,y,r$(r)+a$(24):sysml+12,x,y+1,s$(s)+a$(24)
  30. 180 sysml+12,x,y+2,a$(24)+s$(s):sysml+12,x,y+3,a$(24)+r$(r):poke646,c%(2):return
  31. 190 gosub162:sysml+12,x,y,r$(r):sysml+12,x,y+1,s$(s)
  32. 196 poke646,c%(0):sysml+12,x+1,y,a$(25):sysml+12,x+1,y+1,a$(25)
  33. 198 sysml+12,x,y+2,a$(26):sysml+12,x,y+3,a$(26):poke646,c%(2):return
  34. 204 sysml+12,x,y,r$(r)+s$(s):return
  35. 212 sysml+12,x,y,r$(r):sysml+12,x,y+1,s$(s):return
  36. 220 gosub146:onpgoto226,228,226:sysml+30,x,x-2*(c=cn-1),y,y+3,255,cc:goto230
  37. 226 sysml+30,x,x+1,y,y,255,cc:goto230
  38. 228 sysml+30,x,x,y,y+1,255,cc
  39. 230 return
  40. 234 l=len(a$):onpgoto242,244,246
  41. 240 x=20-l/2:y=ys%(p)-7:goto248
  42. 242 x=xs%(p)+5:y=11:goto248
  43. 244 x=20-l/2:y=ys%(p)+5:goto248
  44. 246 x=xs%(p)-4-l:y=11
  45. 248 poke199,1:sysml+12,x,y,a$:poke199,0:return
  46. 254 sysml+30,x,x+9,y,y,160,c%(2):return
  47. 262 sysml+12,x,y,a$:return
  48. 270 c=-1:fors=3to0step-1:sn%(s,p,p)=0:forr=5to0step-1
  49. 276 ifch%(r,s,p,p)>0thenforn=1toch%(r,s,p,p):c=c+1:r%(c,p)=r:s%(c,p)=s:next
  50. 278 sn%(s,p,p)=sn%(s,p,p)+ch%(r,s,p,p):next:so%(s,p)=12-sn%(s,p,p):next:return
  51. 284 sysml+30,x%(0,1)+2,x%(0,3)-1,y%(0,2)+2,y%(0,0)-1,160,c%(2):return
  52. 292 gosub146:onpgoto316,318,316
  53. 298 ift%(p)>0thenc=t%(p)-1:gosub138:ifs>-1then302
  54. 300 sysml+30,x,x,y,y+3,160,c%(2):goto308
  55. 302 sysml+30,x,x,y,y+1,160,c%(1)
  56. 304 gosub162:sysml+12,x,y+2,s$(s):sysml+12,x,y+3,r$(r):poke646,c%(2)
  57. 306 sysml+30,x-1,x-1,y,y+3,160,c%(1)
  58. 308 x=x+1:sysml+30,x,x,y,y+3,160,c%(2):x=x+1
  59. 310 ift%(p)<11thenc=t%(p)+1:gosub138:ifs>-1then314
  60. 312 sysml+30,x,x,y,y+3,160,c%(2):goto320
  61. 314 gosub162:sysml+12,x,y,r$(r):sysml+12,x,y+1,s$(s):poke646,c%(2):goto320
  62. 316 sysml+30,x,x+1,y,y,160,c%(2):goto320
  63. 318 sysml+30,x,x,y,y+1,160,c%(2)
  64. 320 c=t%(p):return
  65. 326 on1+fnec(p)goto338:onpgoto334,336,334
  66. 332 sysml+30,x%(0,p),x%(15,p)+2,y%(0,p),y%(0,p)+3,160,c%(2):goto338
  67. 334 sysml+30,x%(0,p),x%(0,p)+1,y%(0,p),y%(15,p),160,c%(2):goto338
  68. 336 sysml+30,x%(0,p),x%(15,p),y%(0,p),y%(0,p)+1,160,c%(2)
  69. 338 return
  70. 342 sysml+39,hg:pokerv+48,peek(mv+2):return
  71. 350 sysml+42,hg:pokemv,lg:pokemv+2,peek(rv+48):return
  72. 358 sysml+48,12,28,13,15,fna(6+z):gosub366:bn=n+1:return
  73. 366 n=peek(mv+2):pokerv+49,n:i%=peek(rv+50+z):pokemv+2,n+i%
  74. 372 m=fna(11+z):sysml+129,m,m+4*i%,hd*256+4*n:return
  75. 378 sysml+30,12,28,13,15,160,c%(2):pokemv+2,peek(rv+49):bn=-1:return
  76. 386 sysml+36,i%,255,c%(1):return
  77. 394 sysml+36,i%,255,c%(3):return
  78. 402 sysml+30,xs%(1)+1,xs%(3)-1,ys%(2)+1,ys%(0)-1,160,c%(2)
  79. 408 sysml+30,xs%(0)-1,xs%(0)+10,ys%(0),ys%(0),160,c%(1)
  80. 410 sysml+30,xs%(1),xs%(1),ys%(1)-1,ys%(1)+10,160,c%(1)
  81. 412 sysml+30,xs%(2)-1,xs%(2)+10,ys%(2),ys%(2),160,c%(1)
  82. 414 sysml+30,xs%(3),xs%(3),ys%(3)-1,ys%(3)+10,160,c%(1):return
  83. 420 gosub466:fori=0to1:u%(i)=p%(sb,i,0)+p%(sb,a2%(i),0):v%(i)=u%(i):next
  84. 428 poke646,c%(0):sysml+12,14,8,a$(12):on2+(f=2)goto436
  85. 430 i=tb:on1+np%(i)goto434:i=td:on1+(np%(i)=0)goto436
  86. 432 v%(i)=10*m%(0+sb,i)+10*m%(0+sb,a2%(i)):on2+(u%(i)=v%(i))goto436
  87. 434 poke646,c%(3+i):sysml+12,13,13,t$(i):poke646,c%(0):sysml+12,17,13,a$(13)
  88. 436 l=4:fori=0to1:poke646,c%(3+i):y=9+i:sysml+12,10,y,t$(i)
  89. 438 n=np%(i):gosub494:sysml+12,10+4,y,a$:n=u%(i):gosub494:sysml+12,10+9,y,a$
  90. 440 n=np%(i)+v%(i):on1+(i=tb)goto442:n=n*(f+1):n=n+(n+bp)*(np%(i)<np%(2)orf=2)
  91. 442 gosub494:sysml+12,10+15,y,a$:np%(i)=n:ns%(i)=ns%(i)+n:next
  92. 446 poke646,c%(3+tb):sysml+12,14,12,t$(tb)
  93. 448 poke646,c%(0):sysml+12,18,12,a$(15+(np%(tb)<bp)):poke646,c%(2):m=240:gosub36:gosub474
  94. 454 on2+(ns%(0)<1500andns%(1)<1500)goto462
  95. 456 q=5:gosub466:t=tb+(tb-td)*(ns%(tb)<1500):poke646,c%(3+t):sysml+12,12,10,t$(t)
  96. 460 poke646,c%(0):sysml+12,16,10,a$(16):poke646,c%(2)
  97. 462 return
  98. 466 sysml+30,9,30,7,14,160,c%(4)+16:return
  99. 474 sysml+30,xs%(1)+6,xs%(1)+8,ys%(2),ys%(2),160,c%(1)
  100. 480 sysml+30,xs%(3)-4,xs%(3)-1,ys%(2),ys%(2),160,c%(1)
  101. 482 sysml+30,xs%(1)+6,xs%(1)+9,ys%(0)+1,ys%(0)+2,160,c%(1):l=5:x=xs%(3)-5
  102. 486 fort=0to1:poke646,c%(3+t):n=ns%(t):gosub494:y=ys%(0)+1+t:gosub262:next:poke646,c%(2):return
  103. 494 a$=right$(a$(27)+str$(n),l):return
  104. 502 onpgoto510,508,510
  105. 508 poke646,c%(3):sysml+12,xs%(p)+2,ys%(p),a$(m):goto512
  106. 510 poke646,c%(4):fori=1to6:sysml+12,xs%(p),ys%(p)+i+1,mid$(a$(m),i,1):next
  107. 512 poke646,c%(2):return
  108. 518 fors=0to3:k=0+s:m%(k,p)=ch%(0,s,p,p)
  109. 528 n=0:forl=0to1:a=(ch%(2,s,p,p)>landch%(3,s,p,p)>l):n=n-a:l=1+(1-l)*a:next
  110. 530 k=8+s:m%(k,p)=n
  111. 532 n=0:forl=0to1:forr=1to5:gosub558:r=5+(5-r)*a:next:n=n-a:l=1+(1-l)*a:next
  112. 534 k=17+s:m%(k,p)=n
  113. 536 k=4+s:m%(k,p)=((ch%(2,s,p,p)>1)+(ch%(3,s,p,p)>1))*(m%(17+s,p)=1):next
  114. 542 fork=13to16:r=k-12-(k=16):n=0
  115. 544 forl=0to1:fors=0to3:gosub558:s=3+(3-s)*a:next:n=n-a:l=1+(1-l)*a:next:m%(k,p)=n:next
  116. 550 k=12
  117. 552 m%(k,p)=-(ch%(1,0,p,p)>0andch%(2,3,p,p)>0)-(ch%(1,0,p,p)>1andch%(2,3,p,p)>1)
  118. 554 return
  119. 558 a=(ch%(r,s,p,p)>l):return
  120. 566 m=0:forj=0to3:k=13+j:m=m+(40+20*j)*fnmm(m%(k,p)):next
  121. 578 ifm%(12,p)>0thenm=m+40:ifm%(12,p)>1thenm=m+260
  122. 582 fors=0to3:m=m+20*m%(8+s,p):next:fors=0to3
  123. 588 p%(s,p,0)=m+10*m%(0+s,p):k=17+s:p%(s,p,0)=p%(s,p,0)+150*fnmm(m%(k,p))
  124. 590 onm%(k,p)goto592,594:p%(s,p,0)=p%(s,p,0)+20*m%(8+s,p):goto596
  125. 592 p%(s,p,0)=p%(s,p,0)+20*m%(4+s,p)
  126. 594 p%(s,p,0)=p%(s,p,0)-20*m%(8+s,p)
  127. 596 next:return
  128. 1002 q=3:gosub402:pokemv+2,4:np%(0)=0:np%(1)=0
  129. 1006 pd=a1%(pd)+(a1%(pd)-pd)*(f=2andbp=290):p=pd
  130. 1008 m=17:gosub502:poke176,lr:poke177,hr:poke178,48:sysrl
  131. 1010 sysml+129,fna(2),fna(2)+768,fna(3):sysml+129,fna(2),fna(2)+128,fna(5)
  132. 1012 fori=0to3:p=a1%(p):gosub1034:gosub270:gosub102:next:return
  133. 1034 forc=0to11:v=int((peek(rv+12*p+c)-1)/2):s=int(v/6):r=int(v-s*6)
  134. 1038 ch%(r,s,p,p)=ch%(r,s,p,p)+1:next:return
  135. 1202 bp=290:p=a1%(pd):pb=p:v=0:fori=0to3:bp%(i)=0:v%(i)=-1:next
  136. 1206 gosub518:gosub566:gosub1268:w=0:fors=1to3:ifp%(s,p,3)<p%(w,p,3)then1214
  137. 1210 ifp%(s,p,3)>p%(w,p,3)thenw=s:goto1214
  138. 1211 ifu%(s)<u%(w)then1214
  139. 1212 ifu%(s)>u%(w)thenw=s:goto1214
  140. 1213 ifsn%(s,p,p)>sn%(w,p,p)thenw=s
  141. 1214 next:v%(p)=w
  142. 1224 iffnhp(p)thengosub1360:onqgoto1264,1264,1238
  143. 1236 gosub1346:gosub12:onqgoto1264,1264
  144. 1238 ifathenpb=p:a$=str$(bp):goto1242
  145. 1240 v=vorb%(p):a$=a$(0)
  146. 1242 gosub234:m=40:gosub36:if(vorb%(pb))=15thenon2+(v=15)goto1245,1248
  147. 1244 p=a1%(p):on2+v%(p)goto1206:on2+((vandb%(p))=0)goto1224,1244
  148. 1245 gosub466:poke646,c%(0):sysml+12,16,10,a$(18):poke646,c%(2):m=40:gosub36:goto1264
  149. 1248 gosub284:p=pb:tb=pband253:td=1-tb:iffnhp(p)thengosub1382:onqgoto1264,1264,1254
  150. 1252 sb=v%(p):gosub12:onqgoto1264,1264
  151. 1254 a$=a$(4+sb):gosub234:m=40:gosub36:gosub284:t=tb:m=19:gosub502:s=sb:gosub162
  152. 1260 sysml+12,xs%(p),ys%(p),s$(sb):sysml+12,xs%(p)+9*(1-t),ys%(p)+9*t,s$(sb)
  153. 1261 poke646,c%(3+t):l=4:n=bp:gosub494:x=xs%(3)-4:y=ys%(2):gosub262:poke646,c%(2)
  154. 1264 return
  155. 1268 fors=0to3:p%(s,p,1)=0:p%(s,p,2)=0:u%(s)=0:next
  156. 1276 fors=0to3:m=sn%(s,p,p):ifm=0then1280
  157. 1278 n=0:forr=5to0step-1:n=n+2:u%(s)=u%(s)+ch%(r,s,p,p):r=r+r*(n>=m):next
  158. 1280 next:fors=0to3:sp=s:fork=1to3:sp=a1%(sp):p%(s,p,1)=p%(s,p,1)+u%(sp)*20:next:next
  159. 1284 fors=0to3:j=0:m=sn%(s,p,p)+int(so%(s,p)/3+0.5):ifsn%(s,p,p)=0then1290
  160. 1285 ifu%(s)>=3thenp%(s,p,1)=p%(s,p,1)+20*m:goto1290
  161. 1286 n=0:forr=5to0step-1:n=n+2:j=j+ch%(r,s,p,p):r=r+r*(n>=m):next
  162. 1288 p%(s